home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
mpfeel.lha
/
MPFeel
/
Modules
/
linda-base.em
< prev
next >
Wrap
Lisp/Scheme
|
1992-10-06
|
4KB
|
120 lines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; EuLisp Module Copyright (C) University of Bath 1991 ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; EuLisp Module - Copyright (C) Codemist and University of Bath 1989 ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Name: linda-base ;;
;; ;;
;; Author: Keith Playford ;;
;; ;;
;; Date: 31 May 1990 ;;
;; ;;
;; Description: Basic linda bits and peices for tuples ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Change Log:
;; Version 1.0 (31/5/90)
;;
(defmodule linda-base
(lists
list-operators
extras
arith
classes
streams
ccc
others
tables
vectors) ()
(deflocal *vector-size* 5)
(deflocal *linda-wild-card* 'linda-match-all)
(export *vector-size* *linda-wild-card*)
;;
;; Note:
;; Just a hack to begin with - going for an eq on name and equal on
;; everything else to fit in with Dave's world of tuple vectors.
;;
;; Linda base object...
(defstruct linda-object () ())
(export linda-object)
;; Tuple structure...
(defstruct linda-tuple linda-object
((key initargs (key)
accessor linda-tuple-key)
(fields initargs (fields)
accessor linda-tuple-fields))
constructor make-linda-tuple)
(export linda-tuple linda-tuple-key linda-tuple-fields make-linda-tuple)
;; Match checker...
(defun linda-tuple-matched-p (pattern tuple)
(if (eq (linda-tuple-key pattern) (linda-tuple-key tuple))
;; Field search...
(match-fields (linda-tuple-fields pattern)
(linda-tuple-fields tuple))
nil))
(export linda-tuple-matched-p)
(defun match-fields (pf tf)
(match-fields-aux pf tf (vector-length pf)))
(defun match-fields-aux (pf tf n)
(cond
((= n 0) t)
((match-field (vector-ref pf (- n 1)) (vector-ref tf (- n 1)))
(match-fields-aux pf tf (- n 1)))
(t nil)))
(defun match-field (f1 f2) ;; f1 pattern...
(cond
((or (eq f1 *linda-wild-card*) (eq f2 *linda-wild-card*)) t)
((equal f1 f2) t)
(t nil)))
(defmacro tuple (name . rest)
`(make-linda-tuple
'key ,name
'fields (let ((\@v\@ (make-vector *vector-size* *linda-wild-card*)))
,@(make-tuple-filler rest 0)
\@v\@)))
(defun make-tuple-filler (ll n)
(if (null ll) nil
(cons `((setter vector-ref) \@v\@ ,n ,(car ll))
(make-tuple-filler (cdr ll) (+ n 1)))))
(export tuple)
)